home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d12 / v8n16.arc / ONEDRIVE.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-08-30  |  1.7 KB  |  74 lines
  1. ONEDRIVE.PAS
  2.  
  3.  
  4.  
  5. PROGRAM FloppyDemo;
  6.  
  7. USES Crt;                         {Required for Turbo 4.0}
  8.  
  9. VAR fileptr : Text;
  10.  
  11.  
  12.   FUNCTION NumberOfDisketteDrives : Byte;
  13.     { Returns the number of DISKETTE drives available }
  14.   VAR
  15.     equip : Integer ABSOLUTE $0000 : $0410;
  16.   BEGIN
  17.     IF (equip AND $0001) = 1 THEN
  18.       NumberOfDisketteDrives := ((equip SHR 6) AND $0003)+1
  19.     ELSE
  20.       NumberOfDisketteDrives := 0;
  21.   END;
  22.  
  23.  
  24.   FUNCTION FirstDiskDrive : Char;
  25.     { Returns the letter of first diskette drive (A or B) }
  26.   BEGIN
  27.     IF NumberOfDisketteDrives > 1 THEN FirstDiskDrive := 'A'
  28.     ELSE
  29.       CASE Mem[$0000 : $0504] OF
  30.         00 : FirstDiskDrive := 'A';
  31.         01 : FirstDiskDrive := 'B';
  32.       END;
  33.   END;
  34.  
  35.  
  36.   PROCEDURE MakeFirstDrive(drive : Char);
  37.     { Makes the first diskette drive A or B }
  38.   BEGIN
  39.     IF NumberOfDisketteDrives = 1 THEN
  40.       CASE Upcase(drive) OF
  41.         'A' : Mem[$0000 : $0504] := 00;
  42.         'B' : Mem[$0000 : $0504] := 01;
  43.       END;
  44.   END;
  45.  
  46.  
  47. BEGIN
  48.   ClrScr;
  49.   IF NumberOfDisketteDrives > 1 THEN
  50.     WriteLn('You have more than one floppy drive...terminating')
  51.   ELSE
  52.     BEGIN
  53.       WriteLn('Put a scratch disk into drive A.');
  54.       WriteLn('Reassigning drive A to B.');
  55.  
  56.       IF FirstDiskDrive = 'A' THEN MakeFirstDrive('B');
  57.  
  58.       Write('Press a key to write "B:JUNK.DAT"...');
  59.       IF ReadKey = #0 THEN; {Dummy ReadKey call}
  60.       WriteLn;
  61.  
  62.       Assign(fileptr, 'B:JUNK.DAT');
  63.       Rewrite(fileptr);
  64.       WriteLn(fileptr, 'Test File');
  65.       Close(fileptr);
  66.  
  67.       WriteLn('Done...returning drive to A.');
  68.       MakeFirstDrive('A');
  69.     END;                          {else}
  70. END.
  71.  
  72.  
  73.  
  74.